home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue37 / outlook / Example2 / ComExample2.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-05-16  |  9.4 KB  |  395 lines

  1. {
  2.  
  3. Most simple example of adding a menu item to Exchange
  4. or Outlook.
  5.  
  6. }
  7.  
  8.  
  9.  
  10. unit ComExample2;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows,
  16.   SysUtils,
  17.   CommCtrl,
  18.   ExchExt;
  19.  
  20.  
  21. type
  22.   TExchExt = class(TInterfacedObject, IExchExt, IExchExtCommands)
  23.   protected
  24.   { IExchExt }
  25.     function Install(
  26.                eecb: IEXCHEXTCALLBACK;
  27.                mecontext: ULONG;
  28.                ulFlags: ULONG): HResult; stdcall;
  29.   { IExchExtCommands }
  30.     function InstallCommands(
  31.                eecb: IEXCHEXTCALLBACK;
  32.                hwnd: HWND;
  33.                hmenu: HMENU;
  34.                var cmdidBase: UINT;
  35.                lptbeArray: LPTBENTRY;
  36.                ctbe: UINT;
  37.                ulFlags: ULONG): HResult; stdcall;
  38.     procedure InitMenu(
  39.                 eecb: IExchExtCallback); stdcall;
  40.     function DoCommand(
  41.               eecb: IEXCHEXTCALLBACK;
  42.               cmdid: UINT): HResult; stdcall;
  43.     function Help(
  44.                eecb: IEXCHEXTCALLBACK;
  45.                cmdid: UINT): HResult; stdcall;
  46.     function QueryHelpText(
  47.                cmdid: UINT;
  48.                ulFlags: ULONG;
  49.                lpsz: LPTSTR;
  50.                cch: UINT): HResult; stdcall;
  51.     function QueryButtonInfo(
  52.                tbid: ULONG;
  53.                itbb: UINT;
  54.                ptbb: PTBButton;
  55.                lpsz: LPTSTR;
  56.                cch: UINT;
  57.                ulFlags: ULONG): HResult; stdcall;
  58.     function ResetToolbar(
  59.                tbid: ULONG;
  60.                ulFlags: ULONG): HResult; stdcall;
  61.   private
  62.     CurrentContext: ULONG;
  63.     MyMainButtonIndex,
  64.     MyMainButtonBitmapNo,
  65.     MyMainButtonCommand: integer;
  66.     MyNewMsgWinButtonIndex,
  67.     MyNewMsgWinButtonBitmapNo,
  68.     MyNewMsgWinButtonCommand: integer;
  69.     MyNewMsgMenuCommand: integer;
  70.   end;
  71.  
  72.  
  73.  
  74. implementation
  75.  
  76. uses
  77.   Graphics,
  78.   Dialogs,
  79.   Outlook_TLB;
  80.  
  81.  
  82. { IExchExt }
  83.  
  84. function TExchExt.Install(
  85.   eecb: IEXCHEXTCALLBACK;
  86.   mecontext: ULONG;
  87.   ulFlags: ULONG): HResult;
  88. var
  89.   ulBuildVersion: ULONG;
  90. begin
  91. { make sure this is the right version... }
  92.   eecb.GetVersion(ulBuildVersion, EECBGV_GETBUILDVERSION);
  93.   if (EECBGV_BUILDVERSION_MAJOR <> (ulBuildVersion and EECBGV_BUILDVERSION_MAJOR_MASK)) then  begin
  94.     Result := S_FALSE;
  95.     Exit;
  96.   end;
  97.  
  98.   CurrentContext := mecontext;
  99.  
  100. { in which context(s) do we want to show up? }
  101.   case mecontext of
  102.     EECONTEXT_VIEWER,
  103.     EECONTEXT_SENDNOTEMESSAGE: Result := S_OK;
  104.   else
  105.     Result := S_FALSE;
  106.   end; { of case }
  107.  
  108. end;
  109.  
  110.  
  111.  
  112. { IExchExtCommands }
  113.  
  114. function TExchExt.InstallCommands(
  115.   eecb: IEXCHEXTCALLBACK;
  116.   hwnd: HWND;
  117.   hmenu: HMENU;
  118.   var cmdidBase: UINT;
  119.   lptbeArray: LPTBENTRY;
  120.   ctbe: UINT;
  121.   ulFlags: ULONG): HResult;
  122. var
  123.   r: HResult;
  124.  
  125.   function GetStandardToolbar(var hwndToolbar: Windows.HWnd; var MyButtonIndex: ULONG): Boolean;
  126.   var
  127.     i: integer;
  128.     lptbe: LPTBENTRY;
  129.   begin
  130.     Result := False;
  131.     lptbe := lptbeArray;
  132.     for i := ctbe-1 downto 0 do  begin
  133.       if lptbe.tbid = EETBID_STANDARD then  begin
  134.         hwndToolbar := lptbe.hwnd;
  135.         MyButtonIndex := lptbe.itbbBase;
  136.         Inc(lptbe.itbbBase);
  137.         Result := True;
  138.         break;
  139.       end;
  140.       Inc(lptbe);
  141.     end;
  142.   end;
  143.  
  144.   procedure AddMainWindowButton;
  145.   var
  146.     hwndToolbar: Windows.HWnd;
  147.     tbab: TTBAddBitmap;
  148.   begin
  149.     // add a bitmap to the bitmap list of the toolbar
  150.     if GetStandardToolbar(hwndToolbar, MyMainButtonIndex) then  begin
  151.       tbab.hInst := SysInit.HInstance;
  152.       tbab.nID := 101;
  153.       MyMainButtonBitmapNo := SendMessage(hwndToolBar, TB_ADDBITMAP, 1, LPARAM(@tbab));
  154.       MyMainButtonCommand := cmdidBase;
  155.       Inc(cmdidBase);
  156.     end;
  157.   end;
  158.  
  159.   procedure AddNewMessageMenuItemAndButton;
  160.   var
  161.     hMenuTools: Windows.HMENU;
  162.     hwndToolbar: Windows.HWnd;
  163.     tbab: TTBAddBitmap;
  164.   begin
  165.     r := eecb.GetMenuPos(EECMDID_ToolsOptions, hMenuTools, nil, nil, 0);
  166.     if r <> S_OK then  begin
  167.       r := S_FALSE;
  168.       Exit;
  169.     end;
  170.  
  171.     // add a menu separator
  172.     AppendMenu(
  173.       hMenuTools,
  174.       MF_SEPARATOR,
  175.       0,
  176.       nil);
  177.  
  178.     // add our extension command
  179.     MyNewMsgMenuCommand := cmdidBase;
  180.     AppendMenu(
  181.       hMenuTools,
  182.       MF_BYPOSITION and MF_STRING,
  183.       MyNewMsgMenuCommand,
  184.       'Create a contact');
  185.     Inc(cmdidBase);
  186.  
  187.     // add a bitmap to the bitmap list of the toolbar
  188.     if GetStandardToolbar(hwndToolbar, MyNewMsgWinButtonIndex) then  begin
  189.       tbab.hInst := SysInit.HInstance;
  190.       tbab.nID := 102;
  191.       MyNewMsgWinButtonBitmapNo := SendMessage(hwndToolBar, TB_ADDBITMAP, 1, LPARAM(@tbab));
  192.       MyNewMsgWinButtonCommand := cmdidBase;
  193.       Inc(cmdidBase);
  194.     end;
  195.     // the bitmap itself is installed in QueryButtonInfo
  196.  
  197.     r := S_OK;
  198.   end;
  199.  
  200. begin
  201.   case CurrentContext of
  202.     EECONTEXT_VIEWER: AddMainWindowButton;
  203.     EECONTEXT_SENDNOTEMESSAGE: AddNewMessageMenuItemAndButton;
  204.   else
  205.     r := S_FALSE;
  206.   end;
  207.   Result := r;
  208. end;
  209.  
  210.  
  211. procedure TExchExt.InitMenu(
  212.             eecb: IExchExtCallback);
  213. begin
  214.   // do nothing
  215. end;
  216.  
  217.  
  218. function TExchExt.DoCommand(
  219.           eecb: IEXCHEXTCALLBACK;
  220.           cmdid: UINT): HResult;
  221.  
  222.   procedure DumpSubjectsInCurrentFolder;
  223.  
  224.     function GetTempPath: string;
  225.     const
  226.       BufSize = 1024;
  227.     var
  228.       Buf: array[0..BufSize] of char;
  229.       len: dword;
  230.     begin
  231.       len := Windows.GetTempPath(BufSize, Buf);
  232.       Buf[len] := #0;
  233.       Result := Buf;
  234.     end;
  235.  
  236.   var
  237.     app: Application;
  238.     expl: Explorer;
  239.     folder: MAPIFolder;
  240.     msg: MailItem;
  241.     i: integer;
  242.     fdump: TextFile;
  243.     subject: string;
  244.     ThisIsAMailItem: Boolean;
  245.   begin
  246.     AssignFile(fdump, GetTempPath + '\dump.txt');
  247.     Rewrite(fdump);
  248.     try
  249.       app := CoApplication.Create;
  250.       expl := app.ActiveExplorer;
  251.       folder := expl.CurrentFolder;
  252.       for i := 1 to folder.Items.Count do  begin
  253.         msg := MailItem(folder.Items.Item(i));
  254.         ThisIsAMailItem := msg.MessageClass = 'IPM.Note';
  255.         if ThisIsAMailItem then  begin
  256.           subject := msg.Subject;
  257.           writeln(fdump, subject);
  258.         end;
  259.       end;
  260.     finally
  261.       CloseFile(fdump);
  262.     end;
  263.   end;
  264.  
  265.   procedure CreateJournalAndDisplayIt;
  266.   const
  267.     ShowItModal = True;
  268.   var
  269.     app: Application;
  270.     namespc: NameSpace;
  271.     username: string;
  272.     ji: _DJournalItem;
  273.   begin
  274.     app := CoApplication.Create;
  275.     namespc := app.GetNameSpace('MAPI');
  276.     username := namespc.CurrentUser.Name;
  277.     ji := app.CreateItem(olJournalItem) as _DJournalItem;
  278.     ji.Subject := Format('On %s I, %s, have created a mail message', [DateToStr(Date), username]);
  279.     ji.Type_ := 'E-mail message';
  280.     ji.Body := 'Hello World';
  281.     ji.Start := Now;
  282.     ji.Display(ShowItModal);
  283.     { call ji.Save to save it }
  284.   end;
  285.  
  286.   procedure CreateNewContact;
  287.   var
  288.     app: Application;
  289.     ci: ContactItem;
  290.   begin
  291.     app := CoApplication.Create;
  292.     ci := app.CreateItem(olContactItem) as _DContactItem;
  293.     ci.FirstName := 'Berend';
  294.     ci.MiddleName := 'de';
  295.     ci.LastName := 'Boer';
  296.     ci.FullName := 'Berend de Boer';
  297.     ci.CompanyName := 'NederWare';
  298.     ci.Email1Address := 'berend@pobox.com';
  299.     ci.Email1AddressType := 'SMTP';
  300.     ci.HomeAddressCity := 'Gameren';
  301.     ci.HomeAddressCountry := 'The Netherlands';
  302.     ci.Subject := 'Guess what, this is my name!';
  303.     ci.Body := 'Outlook''s object model is powerful, isn''t it?';
  304.     ci.Save;
  305.   end;
  306.  
  307. begin
  308.   if cmdid = MyMainButtonCommand
  309.     then  begin
  310.       DumpSubjectsInCurrentFolder;
  311.       Result := S_OK;
  312.     end
  313.     else  if cmdid = MyNewMsgMenuCommand
  314.     then  begin
  315.       CreateNewContact;
  316.       Result := S_OK;
  317.     end
  318.     else  if cmdid = MyNewMsgWinButtonCommand
  319.     then  begin
  320.       CreateJournalAndDisplayIt;
  321.       Result := S_OK;
  322.     end
  323.     else
  324.       Result := S_FALSE;
  325. end;
  326.  
  327.  
  328. function TExchExt.Help(
  329.            eecb: IEXCHEXTCALLBACK;
  330.            cmdid: UINT): HResult;
  331. begin
  332.   Result := S_FALSE;
  333. end;
  334.  
  335.  
  336. function TExchExt.QueryHelpText(
  337.            cmdid: UINT;
  338.            ulFlags: ULONG;
  339.            lpsz: LPTSTR;
  340.            cch: UINT): HResult;
  341. begin
  342.   Result := S_FALSE;
  343. end;
  344.  
  345.  
  346. function TExchExt.QueryButtonInfo(
  347.            tbid: ULONG;
  348.            itbb: UINT;
  349.            ptbb: PTBButton;
  350.            lpsz: LPTSTR;
  351.            cch: UINT;
  352.            ulFlags: ULONG): HResult;
  353. begin
  354.   if (CurrentContext = EECONTEXT_SENDNOTEMESSAGE) and
  355.      (tbid = EETBID_STANDARD) and
  356.      (itbb = MyNewMsgWinButtonIndex)
  357.     then  begin
  358.       ptbb.iBitmap := MyNewMsgWinButtonBitmapNo;
  359.       ptbb.idCommand := MyNewMsgWinButtonCommand;
  360.       ptbb.fsState := TBSTATE_ENABLED;
  361.       ptbb.fsStyle := TBSTYLE_BUTTON;
  362.       ptbb.dwData := 0;
  363.       ptbb.iString := -1;
  364.       lstrcpyn(lpsz, 'Create a journal item', cch);
  365.       Result := S_OK;
  366.     end
  367.     else  if (CurrentContext = EECONTEXT_VIEWER) and
  368.              (tbid = EETBID_STANDARD) and
  369.              (itbb = MyMainButtonIndex)
  370.     then  begin
  371.       ptbb.iBitmap := MyMainButtonBitmapNo;
  372.       ptbb.idCommand := MyMainButtonCommand;
  373.       ptbb.fsState := TBSTATE_ENABLED;
  374.       ptbb.fsStyle := TBSTYLE_BUTTON;
  375.       ptbb.dwData := 0;
  376.       ptbb.iString := -1;
  377.       lstrcpyn(lpsz, 'Dump all current subjects', cch);
  378.       Result := S_OK;
  379.     end
  380.     else
  381.       Result := S_FALSE;
  382. end;
  383.  
  384.  
  385. function TExchExt.ResetToolbar(
  386.            tbid: ULONG;
  387.            ulFlags: ULONG): HResult;
  388. begin
  389.   Result := S_OK;
  390. end;
  391.  
  392.  
  393.  
  394. end.
  395.